#   Class hierarchy diagram:
#  $ vgg -t 'Operator(LeftBinaryOp(expr,term),RightBinaryOp(power),PreUnaryOp(uneg),PostUnaryOp(factorial))'
#                           +--------+
#                           |Operator|
#                           +--------+
#          .---------------.----^--------.-------------.
#    +------------+ +-------------+ +----------+ +-----------+
#    |LeftBinaryOp| |RightBinaryOp| |PreUnaryOp| |PostUnaryOp|
#    +------------+ +-------------+ +----------+ +-----------+
#      .---^--.        |              |               |
#    +----+ +----+  +-----+         +----+       +---------+
#    |expr| |term|  |power|         |uneg|       |factorial|
#    +----+ +----+  +-----+         +----+       +---------+
#    
#
# NOTE: package "factor" actually implements numbers and is 
#       outside this hierarchy
#
package Operator;
use strict;
use Carp;

sub Operands {
  my $self = shift;

  return () unless exists $self->{operands};
  return @{$self->{operands}};
}

sub Operators {
  my $self = shift;

  return () unless exists $self->{operators};
  return @{$self->{operators}};
}

sub sem {
  confess "not defined sem";
}

sub make_sem {
  my $class = shift;
  my %semdesc = @_;

  for my $class (keys %semdesc) {
    my %sem = %{$semdesc{$class}};

    # Install 'sem' method in $class
    no strict 'refs';
    no warnings 'redefine';
    *{$class."::sem"} = sub { 
      my ($self, $op) = @_;
      $sem{$op}
    };
  }
}

package LeftBinaryOp;
use base qw{Operator};

sub ceval {
  my $self = shift;

  # recursively evaluate the children first
  my @operands = map { $_->ceval } $self->Operands;

  # then combine them
  my $s = shift @operands;
  for ($self->Operators) {
    $s = $self->sem($_)->($s, shift @operands);  
  }
  return $s;
}

package RightBinaryOp;
use base qw{Operator};

sub ceval {
  my $self = shift;

  # recursively evaluate the children first
  my @operands = map { $_->ceval } $self->Operands;

  # then combine them
  my $s = pop @operands;
  for (reverse $self->Operators) {
    $s = $self->sem($_)->(pop @operands, $s);  
  }
  return $s;
}

package PreUnaryOp;
use base qw{Operator};

sub ceval {
  my $self = shift;

  # recursively evaluate the children first
  my @operands = map { $_->ceval } $self->Operands;

  # then combine them
  my $s = shift @operands;
  for (reverse $self->Operators) {
    $s = $self->sem($_)->($s);  
  }
  return $s;
}

package PostUnaryOp;
use base qw{Operator};

sub ceval {
  my $self = shift;

  # recursively evaluate the children first
  my @operands = map { $_->ceval } $self->Operands;

  # then combine them
  my $s = shift @operands;
  for ($self->Operators) {
    $s = $self->sem($_)->($s);  
  }
  return $s;
}

package term;
use base qw{LeftBinaryOp};

package expr;
use base qw{LeftBinaryOp};

package power;
use base qw{RightBinaryOp};

package uneg;
use base qw{PreUnaryOp};

package factorial;
use base qw{PostUnaryOp};

package statements;
use base qw{LeftBinaryOp};

package exprequal;
use base qw{LeftBinaryOp};

package exprrel;
use base qw{LeftBinaryOp};






1;

